Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/pdoxde/pxmain.frm

Visual Basic Form | 1995-05-08 | 5.6 KB | 208 lines

VERSION 2.00
Begin Form pdox1
   BackColor       =   &H00C0C0C0&
   Caption         =   "Paradox Engine Testing Sheet"
   ClientHeight    =   3765
   ClientLeft      =   1320
   ClientTop       =   1950
   ClientWidth     =   7545
   Height          =   4455
   Icon            =   PXMAIN.FRX:0000
   Left            =   1260
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   ScaleHeight     =   3765
   ScaleWidth      =   7545
   Top             =   1320
   Width           =   7665
   Begin PictureBox Picture1
      BackColor       =   &H00004040&
      Height          =   375
      Left            =   1200
      ScaleHeight     =   345
      ScaleWidth      =   5385
      TabIndex        =   11
      Top             =   3120
      Width           =   5415
   End
   Begin TextBox recdisp
      BackColor       =   &H0000FFFF&
      ForeColor       =   &H00FF0000&
      Height          =   375
      Left            =   1080
      TabIndex        =   10
      Top             =   3000
      Width           =   5415
   End
   Begin CommandButton prevbtn
      Caption         =   "prev"
      Height          =   495
      Left            =   5280
      TabIndex        =   3
      Top             =   1800
      Width           =   975
   End
   Begin CommandButton nextbtn
      Caption         =   "next"
      Height          =   495
      Left            =   5280
      TabIndex        =   2
      Top             =   1080
      Width           =   975
   End
   Begin ListBox flddisp
      BackColor       =   &H0000FFFF&
      ForeColor       =   &H00FF0000&
      Height          =   1395
      Left            =   1080
      TabIndex        =   6
      Top             =   1080
      Width           =   3375
   End
   Begin CommandButton exitbtn
      Caption         =   "exit"
      Height          =   1215
      Left            =   6600
      TabIndex        =   5
      Top             =   720
      Width           =   615
   End
   Begin CommandButton openbtn
      Caption         =   "open"
      Default         =   -1  'True
      Height          =   495
      Left            =   5280
      TabIndex        =   1
      Top             =   360
      Width           =   975
   End
   Begin TextBox filename
      BackColor       =   &H00FFFF00&
      ForeColor       =   &H00FF0000&
      Height          =   375
      Left            =   1080
      TabIndex        =   0
      Top             =   360
      Width           =   3015
   End
   Begin Label Label4
      BackColor       =   &H00C0C0C0&
      Caption         =   "field"
      Height          =   255
      Left            =   360
      TabIndex        =   9
      Top             =   3000
      Width           =   495
   End
   Begin Label Label3
      BackColor       =   &H00C0C0C0&
      Caption         =   "names"
      Height          =   255
      Left            =   360
      TabIndex        =   8
      Top             =   1560
      Width           =   615
   End
   Begin Label Label1
      BackColor       =   &H00C0C0C0&
      Caption         =   "field"
      Height          =   255
      Left            =   360
      TabIndex        =   7
      Top             =   1320
      Width           =   495
   End
   Begin Label Label2
      BackColor       =   &H00C0C0C0&
      Caption         =   "table"
      Height          =   255
      Left            =   360
      TabIndex        =   4
      Top             =   480
      Width           =   495
   End
   Begin Menu aboutpx
      Caption         =   "&About"
   End
   Begin Menu dbase
      Caption         =   "&Database"
   End
Dim pxtbl As Integer
Dim pxrec As Integer
Dim pxfld As Integer
Dim pxFType As String * 255
Dim initflag As Integer
Sub aboutpx_Click ()
    pxabout.Show
End Sub
Sub dbase_Click ()
    Do While flddisp.listcount
       flddisp.RemoveItem 0
    Loop
    recdisp.text = ""
    FileForm.Show
End Sub
Sub exitbtn_Click ()
    rc = PXExit()
    PXError
    End
End Sub
Sub flddisp_Click ()
    pxfld = pdox1.flddisp.ListIndex + 1
    rc = pxFldType(pxtbl, pxfld, 10, pxFType)
    PXError
    GetField pxrec, pxfld, pxFType
    recdisp.text = RTrim$(returnfld)
End Sub
Sub nextbtn_Click ()
    PXNext pxtbl, pxrec
    PXError
    pxfld = pdox1.flddisp.ListIndex + 1
    rc = pxFldType(pxtbl, pxfld, 10, pxFType)
    PXError
    GetField pxrec, pxfld, pxFType
    recdisp.text = returnfld
End Sub
Sub openbtn_CLICK ()
    Dim apName As String
    Dim x As Integer
    apName = "pxtest"
    If initflag = 0 Then
        PXInit apName, PXSHARED
        initflag = 1
    Else
        Do While flddisp.listcount
            flddisp.RemoveItem 0
        Loop
        rc = PXTblClose(pxtbl)
        PXError
    End If
    tIndex = 0 'set open to master table
    pxname$ = RTrim$(filename.text)
    PXOpen pxname$, pxtbl, pxrec
    rc = PXRecNFlds(pxtbl, nFlds)
    PXError
    recdisp.text = "total number of fields: " + Str$(nFlds)
    For x = 1 To nFlds
        rc = PXFldName(pxtbl, x, 255, fldname)
        PXError
        rc = pxFldType(pxtbl, x, 255, pxFType)
        PXError
        fldText$ = LTrim$(RTrim$(fldname)) + " : " + LTrim$(RTrim$(pxFType))
        pdox1.flddisp.AddItem fldText$
    Next x
    rc = PXRecFirst(pxtbl)
    PXError
    rc = PXRecGet(pxtbl, pxrec)
    PXError
End Sub
Sub prevbtn_Click ()
    PXPrev pxtbl, pxrec
    PXError
    pxfld = pdox1.flddisp.ListIndex + 1
    rc = pxFldType(pxtbl, pxfld, 10, pxFType)
    PXError
    GetField pxrec, pxfld, pxFType
    recdisp.text = returnfld
End Sub